home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
cmpnew
/
cmpbind.c
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
7KB
|
274 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpbind.h"
init_cmpbind(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
(void)(putprop(VV[0],VV[1],VV[2]));
MF(VV[9],L2,start,size,data);
MF(VV[10],L3,start,size,data);
MF(VV[11],L4,start,size,data);
MF(VV[1],L5,start,size,data);
vs_top=vs_base=base;
}
/* function definition for C2BIND */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(1);
vs_top=sup;
TTL:;
{object V1= structure_ref(base[0],VV[3],1);
if((V1!= VV[12]))goto T2;
if((structure_ref(base[0],VV[3],3))==Cnil){
goto T4;}
princ_str("\n ",VV[4]);
base[1]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+1,1);
princ_str("=MMcons(",VV[4]);
base[1]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+1,1);
princ_char(44,VV[4]);
(void)simple_symlispcall_no_event(VV[14],base+1,0);
princ_str(");",VV[4]);
base[1]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[15],base+1,1);
base[1]= simple_symlispcall_no_event(VV[16],base+2,0);
structure_set(base[0],VV[3],3,base[1]);
vs_top=(vs_base=base+1)+1;
return;
T4:;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T2:;
if((V1!= VV[17]))goto T21;
princ_str("\n bds_bind(VV[",VV[4]);
base[1]= structure_ref(base[0],VV[3],4);
(void)simple_symlispcall_no_event(VV[18],base+1,1);
princ_str("],",VV[4]);
base[1]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+1,1);
princ_str(");",VV[4]);
setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
base[1]= symbol_value(VV[5]);
vs_top=(vs_base=base+1)+1;
return;
T21:;
princ_str("\n V",VV[4]);
base[1]= structure_ref(base[0],VV[3],4);
(void)simple_symlispcall_no_event(VV[18],base+1,1);
princ_char(61,VV[4]);
{object V2= structure_ref(base[0],VV[3],1);
if((V2!= VV[19]))goto T38;
goto T37;
T38:;
if((V2!= VV[20]))goto T39;
princ_str("fix",VV[4]);
goto T37;
T39:;
if((V2!= VV[21]))goto T41;
princ_str("char_code",VV[4]);
goto T37;
T41:;
if((V2!= VV[22]))goto T43;
princ_str("lf",VV[4]);
goto T37;
T43:;
if((V2!= VV[23]))goto T45;
princ_str("sf",VV[4]);
goto T37;
T45:;
(void)simple_symlispcall_no_event(VV[24],base+1,0);}
T37:;
princ_char(40,VV[4]);
base[1]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+1,1);
princ_str(");",VV[4]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;}
}
/* function definition for C2BIND-LOC */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(2);
vs_top=sup;
TTL:;
{object V3= structure_ref(base[0],VV[3],1);
if((V3!= VV[12]))goto T52;
if((structure_ref(base[0],VV[3],3))==Cnil){
goto T54;}
princ_str("\n ",VV[4]);
base[2]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+2,1);
princ_str("=MMcons(",VV[4]);
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_char(44,VV[4]);
(void)simple_symlispcall_no_event(VV[14],base+2,0);
princ_str(");",VV[4]);
base[2]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[15],base+2,1);
base[2]= simple_symlispcall_no_event(VV[16],base+3,0);
structure_set(base[0],VV[3],3,base[2]);
vs_top=(vs_base=base+2)+1;
return;
T54:;
princ_str("\n ",VV[4]);
base[2]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[13],base+2,1);
princ_str("= ",VV[4]);
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_char(59,VV[4]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
T52:;
if((V3!= VV[17]))goto T77;
princ_str("\n bds_bind(VV[",VV[4]);
base[2]= structure_ref(base[0],VV[3],4);
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_str("],",VV[4]);
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_str(");",VV[4]);
setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
base[2]= symbol_value(VV[5]);
vs_top=(vs_base=base+2)+1;
return;
T77:;
princ_str("\n V",VV[4]);
base[2]= structure_ref(base[0],VV[3],4);
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_str("= ",VV[4]);
{object V4= structure_ref(base[0],VV[3],1);
if((V4!= VV[19]))goto T93;
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[25],base+2,1);
goto T92;
T93:;
if((V4!= VV[20]))goto T95;
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[26],base+2,1);
goto T92;
T95:;
if((V4!= VV[21]))goto T97;
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[27],base+2,1);
goto T92;
T97:;
if((V4!= VV[22]))goto T99;
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[28],base+2,1);
goto T92;
T99:;
if((V4!= VV[23]))goto T101;
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[29],base+2,1);
goto T92;
T101:;
(void)simple_symlispcall_no_event(VV[24],base+2,0);}
T92:;
princ_char(59,VV[4]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;}
}
/* function definition for C2BIND-INIT */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
{object V5= structure_ref(base[0],VV[3],1);
if((V5!= VV[12]))goto T104;
if((structure_ref(base[0],VV[3],3))==Cnil){
goto T106;}
base[2]= list(2,VV[6],structure_ref(base[0],VV[3],2));
bds_bind(VV[7],base[2]);
base[4]= base[1];
base[5]= simple_symlispcall_no_event(VV[30],base+4,1);
bds_unwind1;
princ_str("\n ",VV[4]);
base[3]= base[2];
(void)simple_symlispcall_no_event(VV[18],base+3,1);
princ_str("=MMcons(",VV[4]);
base[3]= base[2];
(void)simple_symlispcall_no_event(VV[18],base+3,1);
princ_char(44,VV[4]);
base[3]= symbol_value(VV[8]);
(void)simple_symlispcall_no_event(VV[14],base+3,1);
princ_str(");",VV[4]);
base[2]= structure_ref(base[0],VV[3],2);
(void)simple_symlispcall_no_event(VV[15],base+2,1);
base[2]= simple_symlispcall_no_event(VV[16],base+3,0);
structure_set(base[0],VV[3],3,base[2]);
vs_top=(vs_base=base+2)+1;
return;
T106:;
base[2]= list(2,VV[6],structure_ref(base[0],VV[3],2));
bds_bind(VV[7],base[2]);
base[3]= base[1];
symlispcall_no_event(VV[30],base+3,1);
bds_unwind1;
return;
T104:;
if((V5!= VV[17]))goto T128;
base[2]= list(2,VV[0],structure_ref(base[0],VV[3],4));
bds_bind(VV[7],base[2]);
base[3]= base[1];
base[4]= simple_symlispcall_no_event(VV[30],base+3,1);
bds_unwind1;
setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
base[2]= symbol_value(VV[5]);
vs_top=(vs_base=base+2)+1;
return;
T128:;
if((V5!= VV[19])
&& (V5!= VV[20])
&& (V5!= VV[21])
&& (V5!= VV[22])
&& (V5!= VV[23]))goto T133;
base[2]= list(3,VV[3],base[0],Cnil);
bds_bind(VV[7],base[2]);
base[3]= base[1];
symlispcall_no_event(VV[30],base+3,1);
bds_unwind1;
return;
T133:;
symlispcall_no_event(VV[24],base+2,0);
return;}
}
/* function definition for SET-BDS-BIND */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(2);
vs_top=sup;
TTL:;
princ_str("\n bds_bind(VV[",VV[4]);
base[2]= base[1];
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_str("],",VV[4]);
base[2]= base[0];
(void)simple_symlispcall_no_event(VV[18],base+2,1);
princ_str(");",VV[4]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}